perm filename PLTCMD.F4[MSS,LCS] blob sn#128711 filedate 1974-11-06 generic text, type T, neo UTF8
00100	C**** PLTCMD, FILLMS, ROTATE ********
00200		SUBROUTINE PLTCMD
00300	CC	IMPLICIT INTEGER(A-Q,S-Z)
00400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00500		DIMENSION NMS(8),RMOV1(8),RMOV2(8)
00710		COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
00721		COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
00732		EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
00743		1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
00754		1,(RMOV1(1),INP(39))
00765	C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
00776	CC	1,(RMOV1(1),INP(21)),(RMOV2(1),INP(31))
01000		F78F(1)='(78F)'
01100		FA5(1)='(A5) '
01200		FA1(1)='(A1) '
01300	
01400		IF(I2.NE.'X')GO TO 1
01500	CC	ML=' '
01600		I2=0
01700		RXC=0
01800		RMOV1(1)='Y'
01900		NAME=0
02000	14	KA=0
02100	3	KA=KA+1
02200	CC	IF(ML.EQ.' ')GO TO 15
02300		IF(ML.EQ.0)GO TO 15
02400		K=K-2
02500		ML=ML-1
02600		IF(ML.EQ.0)GO TO 10
02700		GO TO 31
02800	15	TYPE 2,KA
02900		ACCEPT 11,K,ML
03000	C  TYPE LAST NAME, NUMBER  FOR A SERIES
03100	50	IF(K.EQ.' ')GO TO 10
03200		IF(K.EQ.'99')GO TO 140
03300	C  99=BACKUP
03400	31	IF(LOOKD(K))GO TO 56
03500	C JUMP IF FILE FOUND
03600		TYPE 55
03700		GO TO 15
03800	55	FORMAT(' FILE NOT FOUND'/)
03900	11	FORMAT(A5,I)
04000	56	NMS(KA)=K
04100	CC	IF(ML.EQ.' ')GO TO 5
04200		IF(ML.EQ.0)GO TO 5
04300		RJH='Y'
04400		GO TO 21
04500	5	TYPE 8
04600		ACCEPT FA5,RJH
04700		IF(RJH.EQ.'99')GO TO 15
04800		IF(RJH.NE.'Y')RJH=0
04900		IF(RJH.EQ.0)REREAD F78F,RJH
05000	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
05100	21	RMOV1(KA+1)=RJH
05200		RMOV2(KA)=RJH
05300		GO TO 3
05400	140	KA=KA-1
05500		GO TO 15
05600	
05700	10	KB=KA-1
06100	22	TYPE 9
06200		ACCEPT F78F,RSIZ
06300		IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
06400	222	KA=0
06500	
06600	1	IF(NAME.NE.0)GO TO 12
06700		IF(KA.EQ.KB)GO TO 100
06750	C  EXITB IS FOR FR80 RELEASE ****************
06800		NAME=NMS(KA+1)
06900		TYPE 111,NAME
07000		RETURN
07100	12	KA=KA+1
07200		NAME=0
07300	CC	RJD=1
07400	CC	IF(INP(3).EQ.'C')RJD=0
07500	C  'PXC' = CALCOMP OUTPUT
07600		RJH=0
07700		RJB=RSIZ
07800		RJC=RSIZ
07810	CC	IXRX=RSIZ+.4
07855	C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
07900		RJG=0
08000		RJE=1
08100		RJF=1
08200		IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
08300		IF(RMOV1(KA).NE.0)RJE=0
08310		IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
08350		RETURN
08375	100	TYPE 101
08380		ACCEPT 11,K
08385		IF(K.EQ.'Y')CALL EXITB
08390		CALL EXIT
08395	101	FORMAT(' FOR FR80?? -- '$)
08500	2	FORMAT(' TYPE FILE NAME',I2,1X$)
08600	8	FORMAT(' MOVE UP AT END? ',$)
08700	9	FORMAT(' SIZE FACTOR? ',$)
08800	111	FORMAT(1XA5/)
08900		END
25460	
25500	C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
25600		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
25700		COMMON/DL/RSIZ,SAVER,NAME
25800		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
25900		DIMENSION IDAT(1)
26000		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
26100	CC	DATA MP/2/,MD/6/
26200	C MD=DISPLAY   MP=PLOTTER   MX=XGP
26300		DX=DIS
26400		RX=RHT
26500		D=RSTJC*RJF
26600		R=RSTJC*RJG
26700	4	GO TO 1
26800		C=CC
26900		B=BB
27000	C  SAVES IT.  IT WILL RETURN LATER.
27100		BB=B/DIS
27200		CC=1000
27300	1	KK=0
27400		DO 205 J=1,L
27500		CALL UNPACK(M,N,IDAT(J))
27600		KK=KK+1
27700		NX(KK)=0
27800		IF(LL.EQ.3)NX(KK)=3
27900		X(KK)=ROFF((RJB+D*M)*DIS)
28000		Y(KK)=ROFF((CENTR+R*N)*RHT)
28100	3	GO TO 205
28200		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
28300	C  FOR DISTORTION
28400	205	CONTINUE
28500		NX(1)=KK
28600		DIS=1.0
28700		RHT=DIS
28800	CC	M=MD
28850		IF(IPLT)M=RSIZ+.4
28900		IF(M.LE.0)M=1
29000	C  STOPS DISTORTION IN 'LINES'
29100	2	CALL FILLER(X,Y,NX,M)
29200		DIS=DX
29300		RHT=RX
29400	5	RETURN
29500	C  NEXT TO RESET DISTORTION FACT.
29600		BB=B
29700		CC=C
29800		RETURN
29900		END
30000	
30100		SUBROUTINE ROTATE(I,L)
30200		DIMENSION I(1)
30300		COMMON/LL/LL
30400		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
30500		EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
30600		RJG=RJG*RSTJC
30700		RJF=RJF*RSTJC
30800		N=I(L)
30900		KNT=601
31000	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
31100		I(KNT)=N
31200		DO 1 K=L+1,N+L-1
31300		CALL UNPACK(J,M,I(K))
31400		X=J*RJF
31500		Y=M*RJG
31600		JJ=I(K)/100000000
31700		AX=ATAN2(X,Y)*57.29578
31800		HYP=SQRT(X**2+Y**2)
31900		ROT=DEG+AX
32000		J=ROFF(HYP*COSD(ROT))
32100		M=ROFF(HYP*SIND(ROT))
32200		KNT=KNT+1
32300		IF(J)J=1000-J
32400		IF(M)M=1000-M
32500	1	I(KNT)=M*10000+J+JJ*100000000
32600		L=601
32700		RJF=1.
32800		RJG=1.
32900		RSTJC=1.
33000	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
33100		END